module esmf2mct_mod
#ifdef USE_ESMF_LIB

use ESMF_Mod
use esmfshr_util_mod, only: esmfshr_util_ArrayCopy
use mct_mod
use esmfshr_util_mod
use shr_kind_mod, only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8
use shr_sys_mod , only: shr_sys_abort
use shr_log_mod, only: shr_log_unit, shr_log_level

implicit none

! 
! Author: Fei Liu
!
! This module implements methods that work with ESMF_Array and MCT attribute
! vectors (attrVect) and global segmentation map (gsMap).
! Another layer of utils take these 
! array related methods and put them into interface blocks. user using
! the higher level utils module see/use names such as esmf2mct_init, etc
! Array, AttrVect, and gsMap APIs

public esmf2mct_init
public esmf2mct_copy

private
interface esmf2mct_init
    module procedure esmf2mct_init_AvsGSmap_Arrays
    module procedure esmf2mct_init_Av_Array
    module procedure esmf2mct_init_GGrid_Array
    module procedure esmf2mct_init_GSmap_Gindex
    module procedure esmf2mct_init_GSmap_Distgrid
    module procedure esmf2mct_init_GSmap_Array
    module procedure esmf2mct_init_Gindex_Distgrid
    module procedure esmf2mct_init_Gindex_Array
end interface

interface esmf2mct_copy
    module procedure esmf2mct_copy_a
    module procedure esmf2mct_copy_alist
end interface

contains
!--------------------------------------------------------------------------

! initialize an AttrVect from ESMF_Array
subroutine esmf2mct_init_Av_Array(array, attrVect, rc)

    implicit none

    ! inout parameters
    type(ESMF_Array), intent(inout)         :: array
    type(mct_aVect), intent(out)            :: attrVect
    integer, intent(out), optional          :: rc

    ! local variables
    integer                                 :: localrc, dsize
    character(len=8096)                     :: mct_names
    character(len=*),parameter :: subname = 'esmf2mct_init_Av_Array'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_AttributeGet(array, name="mct_names", value=mct_names, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    ! construct AttrVect
    ! compute dsize for mct - PE local 
    call esmfshr_util_ArrayGetSize(array, lsize2=dsize)

    call mct_aVect_init(aV=attrVect, rList=trim(mct_names), lsize=dsize)

end subroutine esmf2mct_init_Av_Array

!--------------------------------------------------------------------------

! initialize a GGrid from ESMF_Array
subroutine esmf2mct_init_GGrid_Array(array, ggrid, rc)

    implicit none

    ! inout parameters
    type(ESMF_Array), intent(inout)         :: array
    type(mct_ggrid), intent(out)            :: ggrid
    integer, intent(out), optional          :: rc

    ! local variables
    integer                                 :: localrc, dsize, lsize
    character(len=8096)                     :: mct_names
    integer, pointer                        :: gindex(:)
    type(ESMF_distgrid)                     :: distgrid
    character(len=*),parameter :: subname = 'esmf2mct_init_GGrid_Array'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_AttributeGet(array, name="mct_names", value=mct_names, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    ! construct ggrid
    ! compute dsize for mct - PE local 
    call esmfshr_util_ArrayGetSize(array, lsize2=dsize)

    if (len_trim(mct_names) == 0 .and. dsize == 0) then
       return   ! empty domain
    endif

    call mct_gGrid_init( GGrid=ggrid, &
         CoordChars=trim(mct_names), lsize=dsize)
    call mct_aVect_zero(ggrid%data)

    call ESMF_ArrayGet(array, distgrid=distgrid, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call ESMF_DistgridGet(distgrid,localDE=0,elementCount=lsize,rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    if (dsize /= lsize) then
       write(shr_log_unit,*) trim(subname),' ERROR: inconsistent sizes ',dsize,lsize
       call shr_sys_abort(trim(subname))
    endif

    allocate(gindex(lsize))
    call ESMF_DistgridGet(distgrid,localDE=0,seqIndexList=gindex,rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call mct_gGrid_importIAttr(ggrid,'GlobGridNum',gindex,lsize)

    deallocate(gindex)

end subroutine esmf2mct_init_GGrid_Array

!--------------------------------------------------------------------------

! initialize a gsMap from an array
subroutine esmf2mct_init_GSmap_Array(array, COMPID, gsmap, mpicom, gsize, rc)

    implicit none

    ! inout parameters
    type(ESMF_Array), intent(in)            :: array
    integer, intent(in)                     :: COMPID
    type(mct_gsMap), intent(out)            :: gsmap
    integer, intent(in)                     :: mpicom
    integer, intent(in), optional           :: gsize
    integer, intent(out), optional          :: rc

    ! local variables 
    type(ESMF_DistGrid)                     :: distgrid
    integer                                 :: localrc
    character(len=*),parameter :: subname = 'esmf2mct_init_GSmap_Array'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_ArrayGet(array, distgrid=distgrid, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    if (present(gsize)) then
       call esmf2mct_init_GSmap_Distgrid(distgrid, COMPID, gsmap, mpicom, gsize, rc=localrc)
    else
       call esmf2mct_init_GSmap_Distgrid(distgrid, COMPID, gsmap, mpicom, rc=localrc)
    endif
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

end subroutine esmf2mct_init_GSmap_Array

!--------------------------------------------------------------------------

! initialize a gsMap from an array
subroutine esmf2mct_init_Gindex_Array(array, gindex, rc)

    implicit none

    ! inout parameters
    type(ESMF_Array), intent(in)            :: array
    integer, intent(inout), pointer         :: gindex(:)
    integer, intent(out), optional          :: rc

    ! local variables 
    type(ESMF_DistGrid)                     :: distgrid
    integer                                 :: localrc
    character(len=*),parameter :: subname = 'esmf2mct_init_Gindex_Array'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_ArrayGet(array, distgrid=distgrid, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call esmf2mct_init_Gindex_Distgrid(distgrid,gindex,rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

end subroutine esmf2mct_init_Gindex_Array

!--------------------------------------------------------------------------

! initialize a gsMap from a distgrid
subroutine esmf2mct_init_GSmap_Distgrid(distgrid, COMPID, gsmap, mpicom, gsize, rc)

    implicit none

    ! inout parameters
    type(ESMF_DistGrid), intent(in)         :: distgrid
    integer, intent(in)                     :: COMPID
    type(mct_gsMap), intent(out)            :: gsmap
    integer, intent(in)                     :: mpicom
    integer, intent(in), optional           :: gsize
    integer, intent(out), optional          :: rc

    ! local variables 
    type(ESMF_VM)                           :: vm
    integer                                 :: dsize, localrc
    integer, allocatable                    :: gindex(:)
    character(len=*),parameter :: subname = 'esmf2mct_init_GSmap_Distgrid'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    ! query index list
    call ESMF_DistGridGet(distgrid, localDe=0, elementCount=dsize, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    allocate(gindex(dsize), stat=localrc)
    if(localrc /= 0) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call ESMF_DistGridGet(distgrid, localDe=0, seqIndexList=gindex, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    ! finally, construct the gsMap
    if(present(gsize)) then
        call mct_gsMap_init(gsMap, gindex, mpicom, COMPID, dsize, gsize)
    else
        call mct_gsMap_init(gsMap, gindex, mpicom, COMPID, dsize)
    endif
    deallocate(gindex)

end subroutine esmf2mct_init_GSmap_Distgrid

!--------------------------------------------------------------------------

! initialize a gsMap from a distgrid
subroutine esmf2mct_init_Gindex_Distgrid(distgrid, gindex, rc)

    implicit none

    ! inout parameters
    type(ESMF_DistGrid), intent(in)         :: distgrid
    integer, intent(inout), pointer         :: gindex(:)
    integer, intent(out), optional          :: rc

    ! local variables 
    integer                                 :: dsize, localrc
    character(len=*),parameter :: subname = 'esmf2mct_init_Gindex_Distgrid'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    ! query index list
    call ESMF_DistGridGet(distgrid, localDe=0, elementCount=dsize, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    allocate(gindex(dsize), stat=localrc)
    if(localrc /= 0) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call ESMF_DistGridGet(distgrid, localDe=0, seqIndexList=gindex, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

end subroutine esmf2mct_init_Gindex_Distgrid

!--------------------------------------------------------------------------

! initialize a gsMap from a gindex
subroutine esmf2mct_init_GSmap_Gindex(gindex, COMPID, gsmap, mpicom, gsize, rc)

    implicit none

    ! inout parameters
    integer, intent(in)                     :: gindex(:)
    integer, intent(in)                     :: COMPID
    type(mct_gsMap), intent(out)            :: gsmap
    integer, intent(in)                     :: mpicom
    integer, intent(in), optional           :: gsize
    integer, intent(out), optional          :: rc

    ! local variables 
    type(ESMF_VM)                           :: vm
    integer                                 :: dsize, localrc
    character(len=*),parameter :: subname = 'esmf2mct_init_GSmap_Gindex'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    ! construct the gsMap
    dsize = size(gindex, 1)
    if(present(gsize)) then
        call mct_gsMap_init(gsMap, gindex, mpicom, COMPID, dsize, gsize)
    else
        call mct_gsMap_init(gsMap, gindex, mpicom, COMPID, dsize)
    endif

end subroutine esmf2mct_init_GSmap_Gindex

!--------------------------------------------------------------------------

! copy data from ESMF_Array to attrVect
subroutine esmf2mct_copy_a(array, attrVect, rc)

    implicit none

    ! inout parameters
    type(ESMF_Array), intent(in)            :: array
    type(mct_aVect), intent(inout)          :: attrVect
    integer, intent(out), optional          :: rc

    ! local variables
    integer                                 :: a_dsize, a_nfields, localrc
    real(ESMF_KIND_R8), pointer             :: a_fptr(:,:)
    integer                                 :: av_dsize, av_nfields
    integer                                 :: i, j, a_off1, a_off2
    character(len=*),parameter :: subname = 'esmf2mct_copy_a'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_ArrayGet(array, localDe=0, farrayPtr=a_fptr, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

! tcraig - this call seems to change answers, why!!
!    call esmfshr_util_ArrayGetSize(array, lsize1=a_nfields, lsize2=a_dsize)
    a_dsize = ubound(a_fptr, 2)-lbound(a_fptr, 2)+1
    a_nfields = ubound(a_fptr, 1)-lbound(a_fptr, 1)+1

    av_dsize = mct_aVect_lsize(aV=attrVect) 
    av_nfields = mct_aVect_nRAttr(aV=attrVect)

    if (a_dsize == 0 .or. a_nfields == 0) then
       ! nothing to copy, skip size check too
       return
    endif

    if(a_dsize /= av_dsize .or. a_nfields /= av_nfields) then
        write(shr_log_unit,*) trim(subname),' ERROR in sizes ',a_dsize,av_dsize,a_nfields,av_nfields
        call shr_sys_abort(trim(subname))
    endif

    ! attrVect%rattr = a_fptr
    a_off2 = lbound(a_fptr, 2)-1
    a_off1 = lbound(a_fptr, 1)-1

    do j = 1, a_dsize
    do i = 1, a_nfields
       attrVect%rattr(i, j) = a_fptr(a_off1+i, a_off2+j)
    enddo
    enddo

end subroutine esmf2mct_copy_a
 
!--------------------------------------------------------------------------

! copy data from ESMF_Array to attrVect
subroutine esmf2mct_copy_alist(array, attrVect, list, rc)

    ! inout parameters
    type(ESMF_Array), intent(inout)         :: array
    type(mct_aVect), intent(inout)          :: attrVect
    character(len=*), intent(in)            :: list
    integer, intent(out), optional          :: rc

    ! local variables
    type(ESMF_Array)                        :: dstArray
    type(ESMF_DistGrid)                     :: distgrid
    integer                                 :: localrc

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_ArrayGet(array, distgrid=distgrid, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)
   
    !--------------------------------------------------------------------------
    ! use the attribute vector Fortran array pointer to create a temporary Array;
    ! this avoids unnecessary memory copy and code is more efficient
    !--------------------------------------------------------------------------
    dstArray = ESMF_ArrayCreate(farrayPtr=attrVect%rattr, distgrid=distgrid, distgridToArrayMap=(/2/), &
        rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call ESMF_AttributeSet(dstArray, name="mct_names", &
        value=trim(mct_aVect_exportRList2c(attrVect)), rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    ! do a field name based copy between incongruent src and dst Array pairs
    call esmfshr_util_ArrayCopy(array, dstArray, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call ESMF_ArrayDestroy(dstArray, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

end subroutine esmf2mct_copy_alist

!--------------------------------------------------------------------------

! convert ESMF_Array to Attribute Vector and Global Segmentation Map
subroutine esmf2mct_init_AvsGSmap_Arrays(importArray, exportArray, COMPID, mpicom, importAttrVect, exportAttrVect, gsmap, rc)

    implicit none

    ! inout parameters
    type(ESMF_Array), intent(inout)         :: importArray
    type(ESMF_Array), intent(inout)         :: exportArray
    integer, intent(in)                     :: COMPID
    integer, intent(in)                     :: mpicom
    type(mct_aVect), intent(out)            :: importAttrVect
    type(mct_aVect), intent(out)            :: exportAttrVect
    type(mct_gsMap), intent(out)            :: gsmap
    integer, intent(out), optional          :: rc

    ! internal variables
    integer                                 :: localrc
    type(ESMF_DistGrid)                     :: i_distgrid, e_distgrid
    character(len=*),parameter :: subname = 'esmf2mct_init_AvsGSmap_Arrays'
    !---------------------------------------

    if(present(rc)) rc = ESMF_SUCCESS

    ! query array for distgrid
    call ESMF_ArrayGet(importArray, distgrid=i_distgrid, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call ESMF_ArrayGet(exportArray, distgrid=e_distgrid, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    if(.not. ESMF_DistGridMatch(i_distgrid, e_distgrid)) then
         call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)
    endif

    ! initializations
    call esmf2mct_init_GSmap_Distgrid(i_distgrid, COMPID, gsmap, mpicom, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call esmf2mct_init_Av_Array(importArray, importAttrVect, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

    call esmf2mct_init_Av_Array(exportArray, exportAttrVect, rc=localrc)
    if(localrc /= ESMF_SUCCESS) call ESMF_Finalize(rc=localrc, terminationflag=ESMF_ABORT)

end subroutine esmf2mct_init_AvsGSmap_Arrays

!--------------------------------------------------------------------------

#endif
end module
